home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_400 / 422_02 / misc / basic.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-03-20  |  20.8 KB  |  916 lines
  1. /*
  2.  * MICRO BASIC:
  3.  *
  4.  * This is a very simple INTEGER BASIC interpreter that I wrote a number of
  5.  * years ago, and subsequently ported to MICRO-C. While not the greatest
  6.  * example of coding style (it was a quick and dirty hack job), It is quite
  7.  * instructive, as a simple but fairly complete interpreter.
  8.  *
  9.  * Variables:
  10.  *     260 Numeric   variables: A0-A9 ... Z0-Z9
  11.  *     260 Character variables: A0$-A9$ ... Z0$-Z9$
  12.  * 
  13.  *     NOTE: For convenience the '0' variables can be referenced by letter
  14.  *           only. IE: A is equivalent to A0 ... Z$ is equivalent to Z0$
  15.  * 
  16.  * Statements:
  17.  *     LET (default)             - variable = expression
  18.  *     EXIT                    - Terminate MICRO-BASIC
  19.  *     LIST [start,[end]]        - List program lines
  20.  *     LIST#n ...                - List program to file (0-9)
  21.  *     NEW                        - Erase program and variables
  22.  *     RUN [line]                - Run program
  23.  *     CLEAR                    - Erase variables only
  24.  *     GOSUB line                - Call a subroutine
  25.  *     GOTO  line                - Jump to line
  26.  *     RETURN                    - Return from subroutine
  27.  *     PRINT expr[,expr ...]    - Print to console
  28.  *     PRINT#n ...                - Print to file (0-9)
  29.  *     FOR v=init TO limit [STEP increment] - Perform a counted loop
  30.  *     NEXT [v]                - End counted loop
  31.  *     IF test THEN line        - Conditional goto
  32.  *     IF test THEN statement    - Conditional statement (next statement only)
  33.  *     LIF test THEN statements- LONG IF (all statements to end of line)
  34.  *     REM                        - Comment... reminder of line is ignored
  35.  *     STOP                    - Terminate program & issue message
  36.  *     END                        - Terminate program with no message
  37.  *     INPUT var                - Get value for variable
  38.  *     INPUT "prompt",var        - Get value of variable with prompt
  39.  *       NOTE:    prompt must be a constant string, however you can use
  40.  *             a char variable in prompt by concatinating it to such
  41.  *             a string: INPUT ""+a$,b$
  42.  *     INPUT#n,var                - Get value for variable from file (0-9)
  43.  *     OPEN#n,"name","opts"    - Open file (0-9), opts are same as "fopen()"
  44.  *     CLOSE#n                    - Close file (0-9)
  45.  * 
  46.  * Operators:
  47.  *     +                        - Addition, string concatination
  48.  *     -                        - Unary minus, subtraction
  49.  *     *, /, %,                - multiplication, division, modulus
  50.  *     &, |, ^                    - AND, OR, Exclusive OR
  51.  *     =, <>                    - Assignment/test equal, test NOTequal (num or string)
  52.  *     <, <=, >, >=            - LT, LE, GT, GE (numbers only)
  53.  *     !                        - Unary NOT
  54.  * 
  55.  * Functions:
  56.  *     CHR$(value)                - Returns character of passed value
  57.  *     STR$(value)                - Returns ASCII string of value's digits
  58.  *     ASC(char)                - Returns value of passed character
  59.  *     ABS(value)                - Returns absolute value of argument
  60.  *
  61.  * If want to use a different compiler, take note:
  62.  *
  63.  *    -    Make sure 'fgets' does not include the trailing NEWLINE
  64.  *        You can use "microc.h" from utilities source directory.
  65.  *
  66.  *    -    Make sure that 'isalpha' and 'isdigit' can deal with negative
  67.  *        character values (most macro implementations can't). If not,
  68.  *        include those functions from the MICRO-C library.
  69.  *
  70.  *    -    Modify the declaration of 'savjmp' to whatever is appropriate
  71.  *        for your compilers 'setjmp' and 'longjmp' functions.
  72.  *
  73.  * Copyright 1982-1994 Dave Dunfield
  74.  * All rights reserved.
  75.  *
  76.  * Permission granted for personal (non-commercial) use only.
  77.  *
  78.  * Compile command: cc basic -fop
  79.  */
  80. #include <stdio.h>
  81.  
  82. /* Fixed parameters */
  83. #define BUFFER_SIZE 100        /* input buffer size */
  84. #define NUM_VAR 260            /* number of variables */
  85. #define SA_SIZE 100            /* string accumulator size */
  86.  
  87. /* Reserved word grouping */
  88. #define SEC 21                /* secondary keywords */
  89. #define OPS SEC+3            /* first operator */
  90. #define SOPS OPS+14            /* first string function */
  91. #define NOPS SOPS+2            /* first numeric function */
  92.  
  93. /* Control stack constant identifiers */
  94. #define FOR 1000            /* indicate FOR statement */
  95. #define GOSUB FOR+1            /* indicate GOSUB statement */
  96.  
  97. struct line_record {
  98.     unsigned Lnumber;
  99.     struct line_record *Llink;
  100.     char Ltext[]; };
  101.  
  102. static char *reserved_words[] = {
  103.     "LET", "EXIT", "LIST", "NEW", "RUN", "CLEAR", "GOSUB", "GOTO",
  104.     "RETURN", "PRINT", "FOR", "NEXT", "IF", "LIF", "REM", "STOP",
  105.     "END", "INPUT", "OPEN", "CLOSE", "TO", "STEP", "THEN",
  106.     "+", "-", "*", "/", "%", "&", "|", "^",
  107.     "=", "<>", "<=", "<", ">=", ">",
  108.     "CHR$(", "STR$(", "ASC(", "ABS(",
  109.     0 };
  110.  
  111. static char priority[] = {
  112.     0, 1, 1, 2, 2, 2, 3, 3, 3,
  113.     1, 1, 1, 1, 1, 1
  114.     };
  115.  
  116. static char *error_messages[] = {
  117.     "Syntax",
  118.     "Illegal program",
  119.     "Illegal direct",
  120.     "Line number",
  121.     "Wrong type",
  122.     "Divide by zero",
  123.     "Nesting",
  124.     "File not open",
  125.     "File already open",
  126.     "Input"
  127.     };
  128.  
  129. char sa1[SA_SIZE], sa2[SA_SIZE];        /* string accumulators */
  130. struct line_record *pgm_start, *runptr;    /* Line tracking pointers */
  131.  
  132. int num_vars[NUM_VAR] = { 0 };            /* Numeric variables */
  133. char *char_vars[NUM_VAR] = { 0 };        /* Character variables */
  134.  
  135. FILE *files[10]={0}, *filein, *fileout;    /* File unit numbers */
  136.  
  137. int savjmp[3];                            /* Save area for set/longjmp */
  138.  
  139. /* Misc. global variables */
  140. char *cmdptr, buffer[BUFFER_SIZE], mode,  expr_type, nest;
  141. unsigned line, ctl_ptr = 0, ctl_stk[100];
  142.  
  143. /* test for end of expression */
  144. isend(c)
  145.     char c;
  146. {
  147.     if((c >= (0xff80+SEC)) && (c < (0xff80+OPS)))
  148.         return(1);
  149.     return (c == '\0') || (c == ':') || (c == ')') || (c == ',');
  150. }
  151.  
  152. /* test for end of statement */
  153. islend(c)
  154.     char c;
  155. {
  156.     return (c == '\0') || (c == ':');
  157. }
  158.  
  159. /* test for terminator character */
  160. isterm(c)
  161.     char c;
  162. {
  163.     return (c == ' ') || (c == '\t');
  164. }
  165.  
  166. /* advance to next non-blank */
  167. char skip_blank()
  168. {
  169.     while(isterm(*cmdptr))
  170.         ++cmdptr;
  171.     return *cmdptr;
  172. }
  173.  
  174. /* advance to., return and skip next non blank */
  175. char skip_next()
  176. {
  177.     char c;
  178.  
  179.     while(isterm(c=*cmdptr))
  180.         ++cmdptr;
  181.     if(c)
  182.         ++cmdptr;
  183.     return c;
  184. }
  185.  
  186. /* translate to special codes */
  187. translate()
  188. {
  189.     unsigned value;
  190.     char *ptr, c;
  191.  
  192.     cmdptr = ptr = buffer;
  193.  
  194.     while(c = *cmdptr) {
  195.         if(value = lookup(reserved_words))
  196.             *ptr++ = value + 0x80;
  197.         else {
  198.             *ptr++ = c;
  199.             ++cmdptr;
  200.             if(c == '"') {        /* double quote */
  201.                 while((c = *cmdptr) && (c != '"')) {
  202.                     ++cmdptr;
  203.                     *ptr++ = c; }
  204.                 *ptr++ = *cmdptr++; } } }
  205.     *ptr = 0;
  206.     cmdptr = buffer;
  207. }
  208.  
  209. /* prompt for and get a line from standard input */
  210. char get_line(prompt)
  211.     char *prompt;
  212. {
  213.     fputs(prompt, stdout);
  214.     fgets(buffer, BUFFER_SIZE, stdin);
  215.     translate();
  216.     return skip_blank();
  217. }
  218.  
  219. /* get a number from the input buffer */
  220. get_num()
  221. {
  222.     unsigned value;
  223.     char c;
  224.  
  225.     value = 0;
  226.     while(isdigit(c=*cmdptr)) {
  227.         ++cmdptr;
  228.         value = (value * 10) + (c - '0'); }
  229.     return value;
  230. }
  231.  
  232. /* lookup up word from command line in table */
  233. lookup(table)
  234.     char *table[];
  235. {
  236.     unsigned i;
  237.     char *cptr, *optr;
  238.  
  239.     optr = cmdptr;
  240.     for(i=0; cptr = table[i]; ++i) {
  241.         while((*cptr) && (*cptr == toupper(*cmdptr))) {
  242.             ++cptr;
  243.             ++cmdptr; }
  244.         if(!*cptr) {
  245.             skip_blank();
  246.             return i+1; }
  247.         cmdptr = optr; }
  248.     return 0;
  249. }
  250.  
  251. /* main program */
  252. main()
  253. {
  254.     unsigned value;
  255.     char cmd;
  256.  
  257.     pgm_start = 0;
  258.     setjmp(savjmp);
  259.     for(;;) {        /* main command loop */
  260.         mode = ctl_ptr = 0;
  261.         while(!get_line("Ready\n"));    /* insure we get command */
  262.         if(0 > (cmd = skip_blank())) {
  263.             ++cmdptr;
  264.             execute(cmd); }
  265.         else {                                /* not a known command */
  266.             if(isdigit(*cmdptr)) {            /* editing... */
  267.                 value = get_num();            /* get line number */
  268.                 delete_line(value);            /* delete the old */
  269.                 if(skip_blank())
  270.                     insert_line(value); }    /* insert the new */
  271.             else
  272.                 execute(1); } }                /* assume let */
  273. }
  274.  
  275. /* delete a line from the program */
  276. delete_line(lino)
  277.     unsigned lino;
  278. {
  279.     struct line_record *cptr, *bptr;
  280.  
  281.     if(!(cptr = pgm_start))                    /* no lines in pgm */
  282.         return;
  283.     do {
  284.         if(lino == cptr->Lnumber) {            /* we have line to delete */
  285.             if(cptr == pgm_start) {            /* first line in pgm */    
  286.                 pgm_start = cptr->Llink;
  287.                 return; }
  288.             else {
  289.                 bptr->Llink = cptr->Llink;    /* skip it in linked list */
  290.                 free(cptr); } }                /* let it go */
  291.         bptr = cptr; }
  292.     while(cptr = cptr->Llink);
  293. }
  294.  
  295. /* Insert a line into the program */
  296. insert_line(lino)
  297.     unsigned lino;
  298. {
  299.     unsigned i;
  300.     struct line_record *cptr, *bptr, *optr;
  301.     char *ptr;
  302.  
  303.     ptr = cmdptr;
  304.     for(i=5; *ptr; ++i)
  305.         ++ptr;
  306.     if(!(bptr = malloc(i)))
  307.         fputs("No memory\n", stdout);
  308.     else {
  309.         bptr->Lnumber = lino;
  310.         for(i=0; *cmdptr; ++i)
  311.             bptr->Ltext[i] = *cmdptr++;
  312.         bptr->Ltext[i] = 0;
  313.         if((!(cptr = pgm_start)) || (lino < cptr->Lnumber)) {    /* at start */
  314.             bptr->Llink = pgm_start;
  315.             pgm_start = bptr; }
  316.         else {                /* inserting into main part of pgm */
  317.             for(;;) {
  318.                 optr = cptr;
  319.                 if((!(cptr = cptr->Llink)) || (lino < cptr->Lnumber)) {
  320.                     bptr->Llink = optr->Llink;
  321.                     optr->Llink = bptr;
  322.                     break; } } } }
  323. }
  324.  
  325. /* execute commands */
  326. execute(cmd)
  327.     char cmd;
  328. {
  329.     unsigned i,j, k;
  330.     int ii, jj;
  331.     struct line_record *cptr;
  332.     char c;
  333.  
  334.     switch(cmd & 127) {
  335.         case 1 :            /* LET */
  336.             i = get_var();
  337.             j = expr_type;
  338.             if(skip_next() != (0xff88+OPS))
  339.                 error(0);
  340.             k = eval();
  341.             if(j != expr_type)
  342.                 error(0);
  343.             if(!expr_type)        /* numeric assignment */
  344.                 num_vars[i] = k;
  345.             else {                /* character assignment */
  346.                 if(char_vars[i])
  347.                     free(char_vars[i]);
  348.                 if(*sa1)
  349.                     strcpy((char_vars[i] = malloc(strlen(sa1)+1)), sa1);
  350.                 else
  351.                     char_vars[i] = 0; }
  352.             break;
  353.         case 2 :            /* EXIT */
  354.             exit(0);
  355.         case 3 :            /* LIST */
  356.             chk_file(1);
  357.             if(!isdigit(skip_blank())) {
  358.                 i=0; j=-1; }
  359.             else {
  360.                 i = get_num();
  361.                 if(','==skip_next()) {
  362.                     if(isdigit(skip_blank()))
  363.                         j=get_num();
  364.                     else
  365.                         j = -1; }
  366.                 else
  367.                     j=i; }
  368.             disp_pgm(fileout,i,j);
  369.             break;
  370.         case 4 :            /* NEW */
  371.             for(cptr = pgm_start; cptr; cptr = cptr->Llink)
  372.                 free(cptr);
  373.             pgm_start = 0;
  374.             longjmp(savjmp, 1);
  375.         case 5 :            /* RUN */
  376.             if(mode) error(1);
  377.             if(isend(skip_blank()))
  378.                 runptr = pgm_start;
  379.             else
  380.                 runptr = find_line(eval_num());
  381.             --mode;            /* indicate running */
  382.             clear_vars();
  383. newline:
  384.             while(runptr) {
  385.                 cmdptr = runptr->Ltext;
  386.                 line = runptr->Lnumber;
  387.                 do {
  388.                     if((cmd = skip_blank()) < 0) {
  389.                         ++cmdptr;
  390.                         if(i=execute(cmd)) {
  391.                             runptr = i;
  392.                             goto newline; } }
  393.                     else
  394.                         execute(1); }
  395.                 while((c = skip_next()) == ':');
  396.                 if(c)
  397.                     error(0);
  398.                 runptr = runptr->Llink; }
  399.             mode = 0;
  400.             break;
  401.         case 6 :            /* CLEAR */
  402.             clear_vars();
  403.             break;
  404.         case 7 :            /* GOSUB */
  405.             ctl_stk[ctl_ptr++] = runptr;
  406.             ctl_stk[ctl_ptr++] = cmdptr;
  407.             ctl_stk[ctl_ptr++] = GOSUB;
  408.         case 8 :            /* GOTO */
  409.             pgm_only();
  410.             return find_line(eval_num());
  411.         case 9 :            /* RETURN */
  412.             pgm_only();
  413.             if(ctl_stk[--ctl_ptr] != GOSUB)
  414.                 error(6);
  415.             cmdptr = ctl_stk[--ctl_ptr];
  416.             runptr = ctl_stk[--ctl_ptr];
  417.             line = runptr->Lnumber;
  418.             skip_stmt();
  419.             break;
  420.         case 10 :            /* PRINT */
  421.             chk_file(1);
  422.             j = 0;
  423.             --cmdptr;
  424.             do {
  425.                 ++cmdptr;
  426.                 if(islend(skip_blank()))
  427.                     --j;
  428.                 else {
  429.                     i = eval();
  430.                     if(!expr_type) {
  431.                         num_string(i, sa1);
  432.                         putc(' ',fileout); }
  433.                     fputs(sa1, fileout); } }
  434.             while(skip_blank() == ',');
  435.             if(!j)
  436.                 putc('\n', fileout);
  437.             break;
  438.         case 11 :            /* FOR */
  439.             pgm_only();
  440.             ii = 1;            /* default step value */
  441.             i = get_var();
  442.             if(expr_type) error(0);
  443.             if(skip_next() != (0xff88+OPS)) error(0);
  444.             num_vars[i] = eval();
  445.             if(expr_type) error(0);
  446.             if(skip_next() != (0xff80+SEC)) error(0);
  447.             jj = eval();
  448.             if(skip_blank() == (0xff81+SEC)) {
  449.                 ++cmdptr;
  450.                 ii = eval(); }
  451.             skip_stmt();
  452.             ctl_stk[ctl_ptr++] = runptr;    /* line */
  453.             ctl_stk[ctl_ptr++] = cmdptr;    /* command pointer */
  454.             ctl_stk[ctl_ptr++] = ii;        /* step value */
  455.             ctl_stk[ctl_ptr++] = jj;        /* limit value */
  456.             ctl_stk[ctl_ptr++] = i;            /* variable number */
  457.             ctl_stk[ctl_ptr++] = FOR;
  458.             break;
  459.         case 12 :                /* NEXT */
  460.             pgm_only();
  461.             if(ctl_stk[ctl_ptr-1] != FOR)
  462.                 error(6);
  463.             i = ctl_stk[ctl_ptr-2];
  464.             if(!islend(skip_blank()))
  465.                 if(get_var() != i) error(6);
  466.             jj = ctl_stk[ctl_ptr-3];    /* get limit */
  467.             ii = ctl_stk[ctl_ptr-4];    /* get step */
  468.             num_vars[i] += ii;
  469.             if((ii < 0) ? num_vars[i] >= jj : num_vars[i] <= jj) {
  470.                 cmdptr = ctl_stk[ctl_ptr-5];
  471.                 runptr = ctl_stk[ctl_ptr-6];
  472.                 line = runptr->Lnumber; }
  473.             else
  474.                 ctl_ptr -= 6;
  475.             break;
  476.         case 13 :            /* IF */
  477.             i = eval_num();
  478.             if(skip_next() != (0xff82+SEC))
  479.                 error(0);
  480.             if(i) {
  481.                 if(isdigit(cmd = skip_blank()))
  482.                     return find_line(eval_num());
  483.                 else if(cmd < 0) {
  484.                     ++cmdptr;
  485.                     return execute(cmd); }
  486.                 else
  487.                     execute(1); }
  488.             else
  489.                 skip_stmt();
  490.             break;
  491.         case 14 :            /* LIF */
  492.             i = eval_num();
  493.             if(skip_next() != (0xff82+SEC))
  494.                 error(0);
  495.             if(i) {
  496.                 if((cmd = skip_blank()) < 0) {
  497.                     ++cmdptr;
  498.                     return execute(cmd); }
  499.                 else
  500.                     execute(1);
  501.                 break; }
  502.         case 15 :            /* REM */
  503.             if(mode) {
  504.                 if(cptr = runptr->Llink)
  505.                     return cptr;
  506.                 longjmp(savjmp, 1); }
  507.             break;
  508.         case 16 :            /* STOP */
  509.             pgm_only();
  510.             printf("STOP in line %u\n",line);
  511.         case 17 :            /* END */
  512.             pgm_only();
  513.             longjmp(savjmp, 1);
  514.         case 18 :            /* INPUT */
  515.             ii = chk_file(1);
  516.             if(skip_blank() == '"') {        /* special prompt */
  517.                 eval();
  518.                 if(skip_next() != ',') error(0); }
  519.             else
  520.                 strcpy(sa1, "? ");
  521.             i = get_var();
  522.             cptr = cmdptr;
  523. input:        if(ii == -1)
  524.                 fputs(sa1, stdout);
  525.             cmdptr = fgets(buffer,BUFFER_SIZE,filein);
  526.             if(expr_type) {
  527.                 if(char_vars[i]) free(char_vars[i]);
  528.                 strcpy((char_vars[i] = malloc(strlen(buffer)+1)), buffer); }
  529.             else {
  530.                 k = 0;
  531.                 if(skip_blank() == '-') {
  532.                     ++cmdptr;
  533.                     --k; }
  534.                 if(!isdigit(*cmdptr)) {
  535.                     if(ii != -1) error(9);
  536.                     fputs("Input error\n",stdout);
  537.                     goto input; }
  538.                 j = get_num();
  539.                 if(k)
  540.                     j=  0 - j;
  541.                 num_vars[i] = j; }
  542.             cmdptr = cptr;
  543.             break;
  544.         case 19 :            /* OPEN */
  545.             if(skip_blank() != '#') error(0);
  546.             if(files[i = chk_file(0)]) error(8);
  547.             eval_char();
  548.             strcpy(buffer,sa1);
  549.             if(skip_next() != ',') error(0);
  550.             eval_char();
  551.             files[i] = fopen(buffer,sa1);
  552.             break;
  553.         case 20 :            /* CLOSE */
  554.             if((i = chk_file(1)) == -1) error(0);
  555.             if(!filein) error(8);
  556.             fclose(files[i]);
  557.             files[i] = 0;
  558.             break;
  559.         default :            /* unknown */
  560.             error(0); }
  561.         return 0;
  562. }
  563.  
  564. /* test for file operator, and set up pointers */
  565. chk_file(flag)
  566.     char flag;
  567. {
  568.     unsigned i;
  569.  
  570.     i = -1;
  571.     if(skip_blank() == '#') {
  572.         ++cmdptr;
  573.         if(9 < (i = eval_num())) error(7);
  574.         if(skip_blank() == ',')
  575.             ++cmdptr;
  576.         filein = fileout = files[i];
  577.         if(flag && (!filein))
  578.             error(7); }
  579.     else {
  580.         filein = stdin;
  581.         fileout = stdout; }
  582.     return i;
  583. }
  584.  
  585. /* display program listing */
  586. disp_pgm(fp, i, j)
  587.     FILE *fp;
  588.     unsigned i,j;
  589. {
  590.     unsigned k;
  591.     struct line_record *cptr;
  592.     char c;
  593.  
  594.     for(cptr = pgm_start; cptr; cptr = cptr->Llink) {
  595.         k = cptr->Lnumber;
  596.         if((k >= i) && (k <= j)) {
  597.             fprintf(fp,"%u ",k);
  598.             for(k=0; c = cptr->Ltext[k]; ++k)
  599.                 if(c < 0) {
  600.                     c = c & 127;
  601.                     fputs(reserved_words[c - 1], fp);
  602.                     if(c < OPS)
  603.                         putc(' ',fp); }
  604.                 else
  605.                     putc(c,fp);
  606.             putc('\n', fp); } }
  607. }
  608.  
  609. /* test for program only, and error if so */
  610. pgm_only()
  611. {
  612.     if(!mode) error(2);
  613. }
  614.  
  615. /* skip rest of statement */
  616. skip_stmt()
  617. {
  618.     char c;
  619.  
  620.     while((c=*cmdptr) && (c != ':')) {
  621.         ++cmdptr;
  622.         if(c == '"') {
  623.             while((c=*cmdptr) && (c != '"'))
  624.                 ++cmdptr;
  625.             if(c) ++cmdptr; } }
  626. }
  627.  
  628. /* locate given line in source */
  629. find_line(line)
  630.     unsigned line;
  631. {
  632.     struct line_record *cptr;
  633.  
  634.     for(cptr = pgm_start; cptr; cptr = cptr->Llink)
  635.         if(cptr->Lnumber == line)
  636.             return cptr;
  637.     error(3);
  638. }
  639.  
  640. /* dislay error message */
  641. error(en)
  642.     unsigned en;
  643. {
  644.     printf("%s error", error_messages[en]);
  645.     if(mode)
  646.         printf(" in line %u",line);
  647.     putc('\n',stdout);
  648.     longjmp(savjmp, 1);
  649. }
  650.  
  651. /* evaluate number only */
  652. eval_num()
  653. {
  654.     unsigned value;
  655.  
  656.     value = eval();
  657.     if(expr_type)
  658.         error(4);
  659.     return value;
  660. }
  661.  
  662. /* evaluate character only */
  663. eval_char()
  664. {
  665.     eval();
  666.     if(!expr_type)
  667.         error(4);
  668. }
  669.  
  670. /* evaluate an expression */
  671. eval()
  672. {
  673.     unsigned value;
  674.  
  675.     nest = 0;
  676.     value = eval_sub();
  677.     if(nest != 1) error(0);
  678.     return value;
  679. }
  680.  
  681. /* evaluate a sub expression */
  682. eval_sub()    
  683. {
  684.     unsigned value, nstack[10], nptr, optr;
  685.     char c, ostack[10];
  686.  
  687.     ++nest;                        /* indicate we went down */
  688.  
  689. /* establish first entry on number and operator stacks */
  690.     ostack[optr = nptr = 0] = 0;            /* add zero to init */
  691.  
  692.     nstack[++nptr] = get_value();            /* get next value */
  693. /* string operations */
  694.     if(expr_type) {                    /* string operations */
  695.         while(!isend(c = skip_blank())) {
  696.             ++cmdptr;
  697.             c = (c & 0x7f) - (OPS-1);
  698.             get_char_value(sa2);
  699.             if(c == 1)
  700.                 strcat(sa1, sa2);
  701.             else {
  702.                 if(c == 9)
  703.                     value = (0 == strcmp(sa1, sa2));
  704.                 else if(c == 10)
  705.                     value = (1 != strcmp(sa1, sa2));
  706.                 else
  707.                     error(0);
  708.                 nstack[nptr] = value; 
  709.                 expr_type = 0; } } }
  710.  
  711. /* numeric operations */
  712.     else {
  713.         while(!isend(c = skip_blank())) {
  714.             ++cmdptr;
  715.             c = (c & 0x7f) - (OPS-1);
  716.             if(priority[c] <= priority[ostack[optr]]) {    /* execute operand */
  717.                 value = nstack[nptr--];
  718.                 nstack[nptr] = do_arith(ostack[optr--], nstack[nptr], value); }
  719.             nstack[++nptr] = get_value();        /* stack next operand */
  720.             if(expr_type) error(0);
  721.             ostack[++optr] = c; }
  722.         while(optr) {                /* clean up all pending operations */
  723.             value = nstack[nptr--];
  724.             nstack[nptr] = do_arith(ostack[optr--], nstack[nptr], value); } }
  725.     if(c == ')') {
  726.         --nest;
  727.         ++cmdptr; }
  728.     return nstack[nptr];
  729. }
  730.  
  731. /* get a value element for an expression */
  732. get_value()
  733. {
  734.     unsigned value;
  735.     char c, *ptr;
  736.  
  737.     expr_type = 0;
  738.     if(isdigit(c = skip_blank()))
  739.         value = get_num();
  740.     else {
  741.         ++cmdptr;
  742.         if(c == '(')                    /* nesting */
  743.             value = eval_sub();
  744.         else if(c == '!')                /* not */
  745.             value = ~get_value();
  746.         else if(c == (0xff81+OPS))        /* negative */
  747.             value = 0 - get_value();
  748.         else if(c == (0xff80+NOPS)) {    /* ASC */
  749.             eval_sub();
  750.             if(!expr_type) error(4);
  751.             value = 255 & *sa1;
  752.             expr_type = 0; }
  753.         else if(c == (0xff81+NOPS)) {    /* ABS */
  754.             value = eval_sub();
  755.             if(expr_type) error(4);
  756.             if(value > 32767) value = 0- value; }
  757.         else {                /* test for character expression */
  758.             --cmdptr;
  759.             if(isalpha(c)) {        /* variable */
  760.                 value = get_var();
  761.                 if(expr_type) {        /* char */
  762.                     if(ptr = char_vars[value])
  763.                         strcpy(sa1, ptr);
  764.                     else
  765.                         strcpy(sa1, ""); }
  766.                 else
  767.                     value = num_vars[value]; }
  768.             else
  769.                 get_char_value(sa1); } }
  770.     return value;
  771. }
  772.  
  773. /* get character value */
  774. get_char_value(ptr)
  775.     char *ptr;
  776. {
  777.     unsigned i;
  778.     char c, *st;
  779.  
  780.     if((c = skip_next()) == '"') {    /* character value */
  781.         while((c = *cmdptr++) != '"') {
  782.             if(!c) error(0);
  783.             *ptr++ = c; }
  784.         *ptr = 0; }
  785.     else if(isalpha(c)) {            /* variable */
  786.         --cmdptr;
  787.         i = get_var();
  788.         if(!expr_type)
  789.             error(0);
  790.         if(st = char_vars[i])
  791.             strcpy(ptr,st);
  792.         else
  793.             strcpy(ptr,""); }
  794.     else if(c == 0xff80+SOPS) {    /* CHR$ */
  795.         *ptr++ = eval_sub();
  796.         if(expr_type)
  797.             error(4);
  798.         *ptr = 0; }
  799.     else if(c == 0xff81+SOPS) {    /* STR$ */
  800.         num_string(eval_sub(), ptr);
  801.         if(expr_type)
  802.             error(4); }
  803.     else
  804.         error(0);
  805.     expr_type = 1;
  806. }
  807.  
  808. /* perform an arithmetic operation */
  809. do_arith(opr, op1, op2)
  810.     char opr;
  811.     unsigned op1, op2;
  812. {
  813.     unsigned value;
  814.  
  815.     switch(opr) {
  816.         case 1 :        /* addition */
  817.             value = op1 + op2;
  818.             break;
  819.         case 2 :        /* subtraction */
  820.             value = op1 - op2;
  821.             break;
  822.         case 3 :        /* multiplication */
  823.             value = op1 * op2;
  824.             break;
  825.         case 4 :        /* division */
  826.             value = op1 / op2;
  827.             break;
  828.         case 5 :        /* modulus */
  829.             value = op1 % op2;
  830.             break;
  831.         case 6 :        /* logincal and */
  832.             value = op1 & op2;
  833.             break;
  834.         case 7 :        /* logical or */
  835.             value = op1 | op2;
  836.             break;
  837.         case 8 :        /* exclusive or */
  838.             value = op1 ^ op2;
  839.             break;
  840.         case 9 :        /* equals */
  841.             value = op1 == op2;
  842.             break;
  843.         case 10 :        /* not-equals */
  844.             value = op1 != op2;
  845.             break;
  846.         case 11 :        /* less than or equal to */
  847.             value = op1 <= op2;
  848.             break;
  849.         case 12 :        /* less than */
  850.             value = op1 < op2;
  851.             break;
  852.         case 13 :        /* greater than or equal to */
  853.             value = op1 >= op2;
  854.             break;
  855.         case 14 :        /* greater than */
  856.             value = op1 > op2;
  857.             break;
  858.         default:
  859.             error(0); }
  860.     return value;
  861. }
  862.  
  863. /* convert a number to a string, and place in memory */
  864. num_string(value, ptr)
  865.     unsigned value;
  866.     char *ptr;
  867. {
  868.     char cstack[5], cptr;
  869.  
  870.     cptr = 0;
  871.  
  872.     if(value > 32767) {
  873.         *ptr++ = '-';
  874.         value = -value; }
  875.     do
  876.         cstack[cptr++] = (value % 10) + '0';
  877.     while(value /= 10);
  878.     while(cptr)
  879.         *ptr++ = cstack[--cptr];
  880.     *ptr = 0;
  881. }
  882.  
  883. /* clear all variables to zero */
  884. clear_vars()
  885. {
  886.     unsigned i;
  887.     char *ptr;
  888.  
  889.     for(i=0; i < NUM_VAR; ++i) {
  890.         num_vars[i] = 0;
  891.         if(ptr = char_vars[i]) {
  892.             free(ptr);
  893.             char_vars[i] = 0; } }
  894. }
  895.  
  896. /* get index for variable */
  897. get_var()
  898. {
  899.     unsigned index;
  900.     char c;
  901.  
  902.     if(!isalpha(c = skip_next()))
  903.         error(0);
  904.     index = (c - 'A') & 0x1f;
  905.     if(isdigit(c = *cmdptr)) {
  906.         index += (c - '0') * 26;
  907.         c = *++cmdptr; }
  908.     if(c == '$') {
  909.         ++cmdptr;
  910.         expr_type = 1; }
  911.     else
  912.         expr_type = 0;
  913.  
  914.     return index;
  915. }
  916.